home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyCursors.p < prev    next >
Encoding:
Text File  |  1995-10-23  |  3.9 KB  |  173 lines  |  [TEXT/CWIE]
  1. unit MyCursors;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Lists, Dialogs, StandardFile;
  7.  
  8.     procedure StartupCursors;
  9.     procedure CursorSet (c: Cursor);
  10.     procedure CursorSetArrow;
  11.     procedure CursorSetIBeam;
  12.     procedure CursorSetCross;
  13.     procedure CursorSetPlus;
  14.     procedure CursorSetWatch;
  15.     procedure CursorSetProcessing (processing: boolean);
  16.     procedure CursorStandardGetFile(fileFilter:FileFilterProcPtr;numTypes:integer;typeList:SFTypeList;var reply:StandardFileReply);
  17.     procedure CursorStandardPutFile(prompt:Str255;defaultName:Str255;var reply:StandardFileReply);
  18.     
  19. implementation
  20.  
  21.     uses
  22.         Processes, GestaltEqu, ToolUtils, LowMem,
  23.         MyTypes, MyTimeManager, MySystemGlobals, MyStartup;
  24.  
  25.     const
  26.         watch_delay_time = 1800; { ms }
  27.         cursor_task_time = 200; { ms }
  28.  
  29.     var
  30.         state: (S_Leave, S_Waiting, S_Watch);
  31.         ibeam, cross, plus, watch: Cursor;
  32.         current_cursor: Cursor;
  33.         xtm: XTMTask;
  34.         gCursorTaskProc:UniversalProcPtr;
  35.         watch_time:longInt;
  36.         last_processing:Boolean;
  37.         
  38.     procedure UpdateCursor;
  39.     begin
  40.         if in_foreground then begin
  41.             if state = S_Watch then begin
  42.                 SetCursor(watch);
  43.             end
  44.             else begin
  45.                 SetCursor(current_cursor);
  46.             end;
  47.         end;
  48.     end;
  49.  
  50.     procedure CursorTask (xtm: XTMTaskPtr);
  51.     begin
  52.         if (state = S_Waiting) & (LMGetTicks > watch_time) then begin
  53.             state := S_Watch;
  54.             UpdateCursor;
  55.         end;
  56.         XPrimeTime(xtm, gCursorTaskProc, cursor_task_time);
  57.     end;
  58.  
  59.     procedure CursorSet (c: Cursor);
  60.     begin
  61.         current_cursor := c;
  62.         UpdateCursor;
  63.     end;
  64.  
  65.     procedure CursorSetArrow;
  66.     begin
  67.         CursorSet(GetQDGlobals^.arrow);
  68.     end;
  69.  
  70.     procedure CursorSetIBeam;
  71.     begin
  72.         CursorSet(ibeam);
  73.     end;
  74.  
  75.     procedure CursorSetCross;
  76.     begin
  77.         CursorSet(cross);
  78.     end;
  79.  
  80.     procedure CursorSetPlus;
  81.     begin
  82.         CursorSet(plus);
  83.     end;
  84.  
  85.     procedure CursorSetWatch;
  86.     begin
  87.         CursorSet(watch);
  88.     end;
  89.  
  90.     procedure CursorSetProcessing (processing: boolean);
  91.     begin
  92.         if processing <> last_processing then begin
  93.             if processing then begin
  94.                 watch_time := TickCount + watch_delay_time;
  95.                 state := S_Waiting;
  96.             end else begin
  97.                 state := S_Leave;
  98.             end;
  99.             last_processing := processing;
  100.         end;
  101.         UpdateCursor;
  102.     end;
  103.  
  104.     function CursorAlert (alertID: integer; filterProc: ModalFilterProcPtr): integer;
  105.     begin
  106.         CursorSetArrow;
  107.         CursorSetProcessing(false);
  108.         CursorAlert := Alert(alertID, filterProc);
  109.     end;
  110.  
  111.     function CursorCautionAlert (alertID: integer; filterProc: ModalFilterProcPtr): integer;
  112.     begin
  113.         CursorSetArrow;
  114.         CursorSetProcessing(false);
  115.         CursorCautionAlert := CautionAlert(alertID, filterProc);
  116.     end;
  117.  
  118.     function CursorNoteAlert (alertID: integer; filterProc: ModalFilterProcPtr): integer;
  119.     begin
  120.         CursorSetArrow;
  121.         CursorSetProcessing(false);
  122.         CursorNoteAlert := NoteAlert(alertID, filterProc);
  123.     end;
  124.  
  125.     function CursorStopAlert (alertID: integer; filterProc: ModalFilterProcPtr): integer;
  126.     begin
  127.         CursorSetArrow;
  128.         CursorSetProcessing(false);
  129.         CursorStopAlert := StopAlert(alertID, filterProc);
  130.     end;
  131.  
  132.     procedure CursorStandardGetFile(fileFilter:FileFilterProcPtr;numTypes:integer;typeList:SFTypeList;var reply:StandardFileReply);
  133.     begin
  134.         CursorSetArrow;
  135.         CursorSetProcessing(false);
  136.         StandardGetFile(fileFilter,numTypes,@typeList,reply);
  137.     end;
  138.  
  139.     procedure CursorStandardPutFile(prompt:Str255;defaultName:Str255;var reply:StandardFileReply);
  140.     begin
  141.         CursorSetArrow;
  142.         CursorSetProcessing(false);
  143.         StandardPutFile(prompt,defaultName,reply);
  144.     end;
  145.     
  146.     function InitCursors(var msg: integer): OSStatus;
  147.     begin
  148.         msg := msg; { Unused }
  149.         gCursorTaskProc:=NewXTimerProc(@CursorTask);
  150.         state := S_Leave;
  151.         ibeam := GetCursor(iBeamCursor)^^;
  152.         cross := GetCursor(crossCursor)^^;
  153.         plus := GetCursor(plusCursor)^^;
  154.         watch := GetCursor(watchCursor)^^;
  155.         current_cursor := GetQDGlobals^.arrow;
  156.         last_processing := false;
  157.         XInsertTime(@xtm);
  158.         XPrimeTime(@xtm, gCursorTaskProc, cursor_task_time);
  159.         InitCursors := noErr;
  160.     end;
  161.  
  162.     procedure FinishCursors;
  163.     begin
  164.         XRemoveTime(@xtm);
  165.     end;
  166.  
  167.     procedure StartupCursors;
  168.     begin
  169.         StartupTimeManager;
  170.         SetStartup(InitCursors, nil, 0, FinishCursors);
  171.     end;
  172.     
  173. end.